Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xWindow.p

Text File | 1993-04-21 | 47.1 KB | 1,355 lines | [TEXT/PJMM]

unit xWindow;

{ This unit defines the object type xWindows, which encapsulates much of the }
{ standard behavior of Macintosh Windows.  It is meant to be used as an abstract }
{ class.  A programmer can define a descendent class that adds functionality, such }
{ as graphics, text, or additional controls, to the basic behavior.   (An xWindow }
{ could also be used directly for simple applications.) }
{      Also defined in this unit is the abstract class xWindowDecoration.  This }
{ represents things that can be added to windows.  For example, an instance of the }
{ descendent class xButton would be a button that the user could press.    Once }
{ installed in an xWindow, an xWindowDecoration can automatically receive and }
{ respond to events.   (You can directly use an xWindowDecoration to make a }
{ specific cursor appear over a rectangle in the window.) }
{      This unit is meant to be used with the main program StandardMain.p, which }
{ includes an event loop that routes events to appropriate windows.  If the only }
{ windows used in your application are xWindows, you will not need to make any }
{ changes to the main program, except to add support for any menus or menu items }
{ that you add. }
{       To open an use an xWindow, you should declare a variable VAR X: xWindow, }
{ allocate storage with NEW(X), then open the window with X.open or X.openInRect. }
{ As an alternative to the last step, you can set up the appearance of the window before }
{ opening it by calling X.setDefaults, then calling routines such as X.setFeatures to }
{ change the defaults, then calling X.doBasicOpen.  Note that X.doBasicOpen requires the }
{ values of certain instance variables to be set before it is called. }
{       To define a subclass of xWindow, you should generally override one or both of the }
{ methods seDefaults and openInRect.  SetDefaults is the place to do any setup that is }
{ required before the window is opened; it should always be called at the beginning of }
{ openInRect.  OpenInRect should then call doBasicOpen to open the window; after this, }
{ it can make any modifications or additions to the window.  DoBasicOpen itself should }
{ not be modified. }
{       The Macintosh ordinarily identifies windows by WindowPtr's.  Each xWindow }
{ corresponds to some windowPtr.  Sometimes, the Mac gives you only the windowPtr }
{ and you have to find the corresponding xWindow.  A function Window2xWindow is }
{ exported for this purpose. }
{       The exported procedure InitXWindows should be called to initialize this unit; it }
{ is called in StandardMain, and need not be used elsewhrere. }


interface

type

    windowFeatures = (hasGoAway, hasGrow, hasVScroll, hasHScroll, hasZoom, DAStyle);
    windowFeatureSet = set of windowFeatures;

    xWindow = object

      { INSTANCE VARIABLES -- you should not use these directly }

            nextXWindow: xWindow;  { link to next window in list of open xWindows }
            theWindow: WindowPtr;  { the refCon of this window contains a ref to this object }
            userRef: longint;  { not used by xWindows system; available for any use }
            features: windowFeatureSet;  { features this window has }
            minSize, maxSize: point;  { specify min and max allowable sizes during a "Grow window" }
            vScrollTopOffset, vScrollBottomOffset, hScrollLeftOffset, hScrollRightOffset: integer;
                     { amount of space left at ends of scroll bars }
            hLinesPerPage, vLinesPerPage: integer;  { clicking in the "page" area of a }
                     { scroll bar is equivalent to clicking on an arrow this many times }
            hPixelsPerLine, vPixelsPerLine: integer;
            hScroll, vScroll: ControlHandle;  { the horizontal and vertical scroll bars }
            decorations: xWindowDecoration;  { the "decorations" that have been installed in }
                                                            { this window }

     { METHODS YOU ARE LIKELY TO OVERRIDE }

            procedure openInRect (title: string;
                                        left, top, right, bottom: integer);
                { Open a window, with (top,left) as upper left corner and (bottom,right) }
                { as lower right corner of inside of window (excluding title bar). }
                { If the rectangle specified by top, left, right and bottom are empty (for }
                { example, is they are all empty), then the window will fill the screen. }
                { This default method simply calls SetDefaults, then calls doBasicOpen. }
                { You can define a descendent class of xWindow by redefining SetDefaults }
                { and/or openInRect, as described in the comments at the start of the UNIT. }
            procedure open (title: string);
                { Opens a window.  Its width will be 3/4 of the screen width; its height 3/4 }
                { of the screen height, but not more than 2/3 of the width.  Each successive }
                { window will be offset from the previous one.  This method just calculates }
                {  the window rect, then calls openInRect, so in a descendent class, you only }
                { need to redefine openInRect. }
            procedure SetDefaults;
                { This procedure is meant to be called in OpenInRect before the window is }
                { actually opened, to set up parameters that will be used in opening the }
                { window.  The default method calls SetFeatures, SetScrollOffsets,  }
                { SetMinMaxSize, and SetLinesPerPage.  If you want to change any of the }
                { defaults, or if you want to initialize any other instance variables, in a }
                { subclass of xWindows, you should override this method; call INHERITED }
                { SetDefaults, then make any changes or additions.  This could be used, for }
                { example, if you don't want a horizontal scroll bar in your window, or if you }
                { want to set a maximum window size.  }
                {      SHOULD NOT BE CALLED ONCE THE WINDOW IS OPENED.  xWindows does }
                { not support changing features on an open window. }
            procedure doRedraw (badRect: Rect);
                { This is called when the contents of the window need to be redrawn, for }
                { example, when part of the window has been covered by a window which is }
                { then moved out of the way.  The parameter badRect is a rectangle that }
                { includes the part of the window that needs to be redrawn.  In most cases }
                { you can ignore this and draw the whole window, but in some case you might }
                { want to avoid unnecessary drawing.  The default method draws any }
                { xWindowDecorations that have been installed in the window. }
                { DoRedraw is also called during scrolling, unless you override the methods }
                { doHScroll and doVScroll.  If you have scroll bars, you will need to call }
                { GetHMax, GetVMax, GetHVal and GetVVal to determine which part of the }
                {total data needs to be redrawn. }
            procedure doKey (ch: char;
                                        modifiers: longint);
                { Called when the user types a character and this window is the front }
                { window.  The default method sends the keystroke to an xWindowDecoration. }
                { if appropriate.  The parameter Modifiers is a copy of the modifiers field }
                { of the event record, which can be used to determine whether the user was }
                { holding down the option or shift key when the key was pressed. }
            procedure doContentClick (localPt: point;
                                        modifiers: longint);
                { Called when the user clicks in the content area of the window.  This is NOT }
                { called when the user clicks in a scroll bar, grow box, etc.--such events are }
                { handled elsewhere.  The parameter Modifiers is a copy of the modifiers field }
                { of the event record which can be used to determine whether the user was }
                { pressing the command, shift, or option key when the mouse down occure. }
                { The default method sends the click to an xWindowDecoration if appropriate. }
            procedure doClose;
                { Called when the window is being closed because the user clicks in the }
                { close box of the window.  You might also want to call it in response to a }
                { menu selection.  The default method disposes of any xWindowDecorations }
                { and of the horizontal and vertical scroll bars, then closes the window.  It does }
                { not dispose of the storage for the xWindow.  You can use DISPOSE to do so, }
                { or you can open a new window without using NEW on the variable again. }
                { You might want to override this, for example, to dispose of the data that }
                { specifies the contents of the window.  (Note however that the Mac toolbox }
                { procedure CloseWindow takes care of disposing of controls, such as }
                { buttons or check boxes. }
            procedure doHScroll (dh: integer);
            procedure doVScroll (dv: integer);
                { These are called when the user clicks in a scroll bar; they are called }
                { repeatedly as long as the user holds down the mouse button.  The parameters }
                { dh and dv specify the change the user has made in the value of the scroll }
                { bar.  The window contents must be drawn in response.  By default, the old }
                { contents are erased and  doRedraw is called.  If you are satisified with this, }
                { you don't have to redefine these.  However, the jerky visual appearance caused }
                { by erasing the whole window is not attractive. }
            procedure AdjustToNewSize;
                { This is called when the window is resized (because of a doGrow or doZoom }
                { operation.  The default method resizes and repositions the scroll bars and any }
                { xWindowDecoration.  If you have added other stuff, you might need to adjust it. }
                { You will probably also need to set values associated with the scroll bars, }
                { such as HMax, VMax, HVal, VVal, LinesPerPage.  Call INHERITED AdjustToNewSize }
                { to move the scroll bar and decorations. }
            procedure doActivate (active: boolean);
                { This is called when the window is activated or deactivated.  the default }
                { method hides the scroll bars on deactivation and shows them on reactivation. }
                { It also activates and deactivates xWindowDecorations. }
            procedure idle;
                { This will ordinarily be called periodically while this is the front window. }
                { It can be called when there is no other event to be processed.  In some }
                { applications, you might want to call it even when this is not the front }
                { window.  A typically application is to call the ToolBox routine TEIdle when }
                { to blink the cursor in an active text edit.  The default routine sends idle }
                { messages to any xWindowDecorations that have been installed. }

    { METHODS FOR SETTING AND READING VALUES }

            procedure SetHMax (theMax: integer);
            procedure SetVMax (theMax: integer);
            procedure SetHVal (theVal: integer);
            procedure SetVVal (theVal: integer);
            function GetHMax: integer;
            function GetVMax: integer;
            function GetHVal: integer;
            function GetVVal: integer;
            procedure SetLinesPerPage (hPage, vPage: integer);
                { The values of the horizontal and vertical scroll bars go from zero to a }
                { user-specified maximum.  Methods are provided to set and read both the }
                { values and the maximums.  When the user clicks in the arrow of a scroll }
                { bar, the value changes by ±1.   When the user clicks in the gray area of }
                { the bar, it should change by an amount representing, more or less, a page }
                { of data.  SetLinesPerPage determines how many units the value should change }
                { by when the user clicks in the gray area.  The method SetDefaults sets the }
                { page sizes to 1, so that clicking in the gray area will have the same effect }
                { as clicking on an arrow.  Note that page sizes will generally have to be }
                { changed when the window changes size. }

            procedure setTitle (str: string);
            function getTitle: str255;
                { These methods set and read the title displayed in the window's title bar. }

            procedure SetUserRef (theRef: longint);
            function GetUserRef: longint;
                { These methods set and read a reference number associated with the }
                { window.  xWindow makes no use of this number; it is provided for the }
                { user, for example to store a handle to data displayed in the window. }

    { UTILITY METHODS }

            procedure hide;
            procedure show;
            procedure move (left, top: integer);
            procedure setWindowSize (width, height: integer);
                { These four methods allow you to directly hide the window, show it, move it }
                { and set its size.  Procedure move moves the widow without changing its }
                { size so that its upper left corner at the point (left,top).  Procedure }
                { setWindowSize adjusts the lower right corner to acheive the specified }
                { width and height, and then calls AdjustToNewSize. }

    { METHODS FOR REWRITTING open }

            procedure SetFeatures (theFeatures: windowFeatureSet);
                { Change the feature list.  DO NOT CALL ONCE THE WINDOW IS OPENED. }
            procedure SetScrollOffsets (vTop, vBottom, hLeft, hRight: integer);
                { Change the space left at the ends of the scroll bars.  By default, no extra }
                { space is left.  For example, you could use this if you want the vertical }
                { scroll to start 50 points from the top of the window.  You should probably }
                { adjust the maximum and minimum sizes with SetMaxMinSize to make sure }
                { the window contains enouge space for the scroll bars.  You should not call }
                { this procedure while the window is open (but if you really want to, you }
                { call it and then use the Mac toolbox routine InvalRect to force a window }
                { redraw.) }
            procedure SetMinDragWidth (minWidth: integer);
            procedure SetMaxDragWidth (maxWidth: integer);
            procedure SetMinDragHeight (minHeight: integer);
            procedure SetMaxDragHeight (maxHeight: integer);
                { These determine the maximum and minimum sizes of the window when the user }
                { drags the window's GrowBox to resize the window.  By default, the minimums are }
                { very small and the maximums are essentially infinite.   You should make sure that }
                { minimum size is sufficient to contain any "decorations you add to the window.  }
                { Also, make sure the original window fits in the specified ranges. }
            procedure doBasicOpen (title: string;
                                        left, top, right, bottom: integer);
                { Opens the window, using (left,top) and (bottom,right) as the upper left }
                { and lower right corners of the content rectangle of the window (excluding }
                { the title bar and border).  DO NOT CALL UNTIL VALUES HAVE BEEN SET }
                { WITH PRECEDING PROCEDURES. }

    { METHODS YOU WILL PROBABLY NEVER CHANGE OR USE DIRECTLY }

            procedure doEvent (event: eventRecord);
                 { Called to handle an event directed to this window; directs the event }
                 { to one of the following methods or to doActivate or to doKey. }
            procedure doUpdate;
                 { Handles an update event for the window; calls doRedraw. }
            procedure doClick (globalPt: point;
                                        modifiers: longint);
                 { Handles a click anywhere in the window by calling appropriate method }
            procedure doGrow (startPt: point);
                 { Handles a user click in the GrowBox }
            procedure doDrag (startPt: point);
                 { Handles a user click in the title bar (exclusive of goAwayBox or ZoomBox }
            procedure doZoom (startPt: point;
                                        partNum: integer);
                { Handles a user click in the ZoomBox }
            procedure adjustCursor (localPt: point);
                { if the cursor is over an xWindowDecoration, this sets the cursor to }
                { cursor for that decoration; otherwise it sets the cursor to the standard }
                { arrow }

        end;  { definition of xWindows }

    xWindowDecoration = object
            { abstract class defining the common protocol for objects, such as buttons, }
            { pictures, and input boxes, that can be added to xWidows. }

   { INSTANCE VARIABLES }

            itsWindow: xWindow;  { the window into which the decoration has been installed }
            nextDecoration: xWindowDecoration;  { link in list of decorations for that window }
            drawRect: Rect;  { rectangle completely containing the item }
            clickRect: Rect;  { a rectangle containing the part of the decoration that can respond }
                                 { to clicks (if any);  should be contained in drawRect; by default is }
                                 { equal to drawRect }
            left, top, height, width: integer;  { values determining position and size of object }
                                   { (See procedure Install for a description ) }
            visible: boolean;  { set to false if item is hidden }
            wantsKey, wantsClick, wantsCR: boolean;  { determines whether events are sent }
                                   { by xWindow procedures to this decoration; generally, only the }
                                   { first (most recent) item in the decoration list that wants the event }
                                   { receives it. }
            itsCursor: cursor;   { the cursor to be displayed over this item's clickRect, if it is }
                                       { active and visible }
            grayedOut: boolean;  { set to true by some descendent class when the item is deactivated }

  { METHODS FOR INITIALIZING THE DECORATION }

            procedure init;
             { inialize most of the instance variables; should be called before you do }
             { anything else with the object. }
            procedure install (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
             { Add an init'ed object to the specified xWindow.  The values of theLeft and }
             { theTop determine the top left cornor of the drawRect of the item.   If both }
             { are >= 0, then they simply give the coordinated of the that point.  If theLeft }
             { is < 0, then the left side of the drawRect will be given by subtracting }
             { abs(theLeft) from the right side of the window.  For example, if topLeft is }
             { -50, then the top left cornor of the item will be 50 pixels in from the right }
             { edge of the window; this relationship will be reestablished when the window }
             { is resized by moving the item if necessary. }
             {      Similarly, if theTop is < 0, then it gives the position of the top of the }
             { decoration as an offset from the bottom edge of the window, so that the top }
             { of the decoration will remain at a fixed height above the bottom of the window, }
             { given by abs(theTop). }
             {       Once the top, left cornor of the decoration is deterimined, then theWidth }
             { theHeight are used to determine the width and height of the item.  If they are }
             { both > 0, then they simply specify the actual height and width.  If theHeight is }
             { <= 0, then its value is used as follows:  the right edge of the decoration's drawRect }
             { will be positioned abs(theHeight) pixels in from the right edge of the window. }
             { Similarly, if theWidth is <= 0, then the bottom edge of the decoration will be }
             { abs(theWidth) pixels above the bottom edge of the window. }
             {     Note that theLeft, theTop, theWidth and theHeight are stored in the instance }
             { variables left, top, width and height and are used to recompute the position and }
             { size of the decoration when the size of the window changes. }
             {      All this is not as confusing as it may sound.  Here are some examples: }
             { Install(xWin,10,10,-10,30):  the decoration is 30 units high, with top left }
             {                 cornor at (10,10).  It stretches all across the top of the window. }
             { Install(xWin,-60,20,40,40):  the decoration occupies a 40 by 40 square }
             {                 that hangs in the top right cornor of the window. }

  { METHODS FOR MANIPULATING THE DECORATION }

            procedure move (newLeft, newTop: integer);
             { move the decoration; newLeft and newTop have the same meaning as theLeft }
             { and theTop in procedure Install.  }
            procedure setSize (newWidth, newHeight: integer);
             { change the size of the decoration; newWidth and newHeight have the same }
             { meaning as theWidth and theHeight in procedure Install }
            procedure remove;
             { removes the item from its window, without destroying the data structures; }
             { it could then potentially be installed in another window }
            procedure kill;
             { remove the item from its window and dispose of all storage (including calling }
             { Dispose on the object itself }
            procedure hide;
             { make the decoration invisible; it can be made visible again with Show }
            procedure show;
             { makes a hidden decoration visible again }
            procedure useCursor (c: cursor);
             { specify that this cursor should be shown when the cursor position is over this }
             { decoration's clickRect (and it is visible and not grayed out); by default, a }
             { standard arrow cursor is used }
            procedure forceRedraw;
             { forces an update event for the drawRect of this decoration }

  { METHODS CALLED IN RESPONSE TO VARIOUS EVENTS }

            procedure adjustSize;
              {called by install, setSize, move and xWindow.AdjustToNewSize to do the }
              { calculation of the position and size of the decoration, as described in }
              { procedure install; if you override this method, you can make any other }
              { adjustments necessary when your decoration is moved or resized }
            procedure doKey (ch: char;
                                        modifiers: longint);
              { handle a keystroke, other than CR or ENTER;  this is sent by procedure }
              { xWindow.doKey to the first decoration in the window for which the instance }
              { variable wantsKey is true (if any);  "modifiers" is the modifiers field of }
              { the event record for the keyDown event. }
            procedure doCR (ch: char);
              { respond to user pressing either CR or ENTER;  this is sent by procedure }
              { xWindow.doKey to the first decoration in the window for which the instance }
              { variable wantsKey is true (if any) }
            procedure doClick (localPt: point;
                                        modifiers: longint);
               { respond to the user clicking the mouse;  this is sent by procedure }
               { xWindow.doContentClick to the first decoration it finds whose clickRect }
               { contains the given point }
            procedure doDraw;
               { redraws the decoration; called by xWindow.doRedraw }
            procedure doActivate (active: boolean);
               { respond to an activate event for the window }
            procedure Idle;
               { this is sent once each time through the event loop to any active, visible }
               { decoration in the front window; sent by xWindow.idle. }

        end;  { definition of xWindowDecoration }


var
    windowRect: Rect;  { used in opening widnows in procedure xWindows.openInRect. }

procedure InitXWindows;
{ This procedure is called in StandardMain; all it does is initialize the list of open }
{ xWindows to NIL }


function Window2xWindow (win: WindowPtr;
                            var xWin: xWindow): boolean;
{ looks up a Macintosh window in the list of open xWindows; returns TRUE if it is }
{ found, FALSE if not.  If it is found, xWin is set to be the xWindow corresponding to }
{ the Macintosh window. }


procedure TellUser (message: string);
{ a utility procedure that simply displays an alert box containing the message, with an}
{ OK button for the user to click;  requires the presense of the alert resource #129 in }
{ resources for the program }


implementation

var
    FirstWin: xWindow;

procedure TellUser (message: string);
    var
        bttn: integer;
    begin
        ParamText(message, '', '', '');
        SetCursor(arrow);
        bttn := NoteAlert(129, nil);
        if bttn = -1 then
            Sysbeep(5);
    end;

procedure InitXWindows;
    begin
        FirstWin := nil;
    end;

function Window2xWindow (win: WindowPtr;
                                var xWin: xWindow): boolean;
    begin
        xWin := FirstWin;
        while (xWin <> nil) & (xWin.theWindow <> win) do
            xWin := xWin.nextXWindow;
        Window2xWindow := xWin <> nil;
    end;

procedure GetWindowRect (var left, top, right, bottom: integer);
   { provides a succession of rectangles for opening windows, each offset over and down }
   { from the last. }
    var
        r: Rect;  { a full screen }
        w, h: integer;  { width and height of window rect }
    begin
        r := screenbits.bounds;
        r.top := r.top + 38;
        w := (3 * (r.right - r.left) div 4);
        h := (3 * (r.bottom - r.top) div 4);
        if w > 1000 then
            w := 1000;
        if h > 2 * w div 3 then
            h := 2 * w div 3;
    { we have to be carefull to initialize windowRect if it is not of the right size or not on the }
    { screen, as is almost certainly the case when the program starts. }
        if not PtInRect(windowRect.topLeft, R) | (w <> windowRect.right - windowRect.left) | (h <> windowRect.bottom - windowRect.top) then begin
                left := r.left + 4;
                top := r.top + 4;
                bottom := top + h;
                right := left + w;
                SetRect(windowRect, left, top, right, bottom);
            end
        else begin
                OffsetRect(WindowRect, 15, 15);
                if windowRect.Right > R.right - 2 then begin
                        windowRect.left := R.left + 4;
                        windowRect.right := windowRect.left + w;
                        if windowRect.bottom > R.bottom - 2 then begin
                                windowRect.top := R.top + 11;
                                windowRect.bottom := windowRect.top + h;
                            end;
                    end
                else if windowRect.bottom > R.bottom - 2 then begin
                        windowRect.top := R.top + 4;
                        windowRect.bottom := windowRect.top + h;
                    end;
                left := windowRect.left;
                right := windowRect.right;
                top := windowRect.top;
                bottom := windowRect.bottom;
            end;
    end;

procedure xWindow.open (title: string);
    var
        left, top, right, bottom: integer;
    begin
        GetWindowRect(left, top, right, bottom);
        openInRect(title, left, top, right, bottom);
    end;

procedure xWindow.openInRect (title: string;
                                left, top, right, bottom: integer);
    begin
        SetDefaults;
        doBasicOpen(title, left, top, right, bottom);
    end;

procedure xWindow.doRedraw (badRect: Rect);
    var
        d: xWindowDecoration;
        junk: rect;
    begin
        d := decorations;
        while d <> nil do begin
                if SectRect(d.drawRect, badRect, junk) & d.visible then
                    d.doDraw;
                d := d.nextDecoration;
            end;
    end;

procedure xWindow.doContentClick (localPt: point;
                                modifiers: longint);
    var
        d: xWindowDecoration;
    begin
        d := decorations;
        while d <> nil do
            if PtInRect(localPt, d.clickRect) & d.wantsClick & d.visible then begin
                    d.doClick(localPt, modifiers);
                    EXIT(doContentClick);
                end
            else
                d := d.nextDecoration;
    end;

procedure xWindow.doKey (ch: char;
                                modifiers: longint);
    var
        d: xWindowDecoration;
    begin
        d := decorations;
        if (ch = chr(13)) | (ch = chr(3)) then begin
                while d <> nil do
                    if d.wantsCR & d.visible then begin
                            d.doCR(ch);
                            EXIT(doKey);
                        end
                    else
                        d := d.nextDecoration;
            end
        else
            while d <> nil do
                if d.wantsKey & d.visible then begin
                        d.doKey(ch, modifiers);
                        EXIT(doKey);
                    end
                else
                    d := d.nextDecoration;
    end;

procedure xWindow.Idle;
    var
        d: xWindowDecoration;
    begin
        d := decorations;
        while d <> nil do begin
                if d.visible and not d.grayedOut then
                    d.idle;
                d := d.nextDecoration;
            end;
    end;

procedure xWindow.SetDefaults;
    var
        min, max: point;
    begin
        SetFeatures([hasGoAway, hasHScroll, hasVScroll, hasZoom, hasGrow]);
        SetScrollOffsets(0, 0, 0, 0);
        SetLinesPerPage(1, 1);
        SetMinDragWidth(50);
        SetMinDragHeight(50);
        SetMaxDragWidth(maxint);
        SetMaxDragHeight(maxint);
        hpixelsPerLine := 1;
        vpixelsPerLine := 1;
    end;

procedure xWindow.SetFeatures (theFeatures: windowFeatureSet);
    begin
        features := theFeatures;
    end;

procedure xWindow.SetScrollOffsets (vTop, vBottom, hLeft, hRight: integer);
    begin
        vScrollTopOffset := vTop;
        vScrollBottomOffset := vBottom;
        hScrollLeftOffset := hLeft;
        hScrollRightOffset := hRight;
    end;

procedure xWindow.SetLinesPerPage (hPage, vPage: integer);
    begin
        hLinesPerPage := hPage;
        vLinesPerPage := vPage;
    end;

procedure xWindow.SetMinDragWidth (minWidth: integer);
    begin
        minSize.h := minWidth;
    end;

procedure xWindow.SetMaxDragWidth (maxWidth: integer);
    begin
        maxSize.h := maxWidth;
    end;

procedure xWindow.SetMinDragHeight (minHeight: integer);
    begin
        minSize.v := minHeight;
    end;

procedure xWindow.SetMaxDragHeight (maxHeight: integer);
    begin
        maxSize.v := maxHeight;
    end;

procedure xWindow.doBasicOpen (title: string;
                                left, top, right, bottom: integer);
    var
        R, openRect: Rect;
        windowProc: integer;
        goAway: boolean;
        win: WindowPtr;
    begin
        if minSize.h <= 10 then
            minSize.h := 30;
        if maxSize.h <= minSize.h then
            maxSize.h := minSize.h;
        if minSize.v <= 10 then
            minSize.v := 30;
        if maxSize.v <= minSize.v then
            maxSize.v := minSize.v;
        if hScrollLeftOffset < 0 then
            hScrollLeftOffset := 0;
        if hScrollRightOffset < 0 then
            hScrollRightOffset := 0;
        if vScrollTopOffset < 0 then
            vScrollTopOffset := 0;
        if vScrollBottomOffset < 0 then
            vScrollBottomOffset := 0;
        SetRect(openRect, left, top, right, bottom);
        if EmptyRect(openRect) then begin
                openRect := screenBits.bounds;
                InsetRect(openRect, 5, 5);
                openRect.top := openRect.top + 38;
            end;
        if openRect.bottom < openRect.top + 30 then
            openRect.bottom := openRect.top + 30;
        if openRect.right < openRect.left + 30 then
            openRect.right := openRect.left + 30;
        goAway := hasGoAway in features;
        if hasGrow in features then
            windowProc := documentProc
        else
            windowProc := noGrowDocProc;
        if hasZoom in features then
            windowProc := windowProc + 8;
        if DAStyle in features then
            win := NewWindow(nil, openRect, title, true, rDocProc, pointer(-1), goAway, longint(self))
        else
            win := NewWindow(nil, openRect, title, true, windowProc, pointer(-1), goAway, longint(self));
        theWindow := win;
        decorations := nil;
        if hasVScroll in features then begin
                R := theWindow^.portRect;
                R.right := R.right + 1;
                if (hasGrow in features) then
                    R.bottom := R.bottom - 14
                else
                    R.bottom := R.bottom + 1;
                R.left := R.right - 16;
                R.top := R.top + vScrollTopOffset - 1;
                R.bottom := R.bottom - vScrollBottomOffset;
                vScroll := NewControl(win, R, '', false, 0, 0, 0, scrollBarProc, longint(self));
            end;
        if hasHScroll in features then begin
                R := theWindow^.portRect;
                if (hasGrow in features) | (hasVScroll in features) then
                    R.right := R.right - 14
                else
                    R.right := R.right + 1;
                R.bottom := R.bottom + 1;
                R.top := R.bottom - 16;
                R.left := R.left + hScrollLeftOffset - 1;
                R.right := R.right - hScrollRightOffset;
                hScroll := NewControl(win, R, '', false, 0, 0, 0, scrollBarProc, longint(self));
            end;
        nextXWindow := FirstWin;
        FirstWin := self
    end;

procedure xWindow.doClose;
    var
        d, nextD: xWindowDecoration;
        runner: xWindow;
    begin
        d := decorations;
        while d <> nil do begin
                nextD := d.nextDecoration;
                d.kill;
                d := nextD;
            end;
        if self = FirstWin then                            { remove self from list of xWindows }
            FirstWin := FirstWin.nextXWindow
        else begin
                runner := FirstWin;
                while (runner.nextXWindow <> nil) & (runner.nextXwindow <> self) do
                    runner := runner.nextXWindow;
                if runner.nextXWindow <> nil then
                    runner.nextXWindow := runner.nextXWindow.nextXWindow;
            end;
        CloseWindow(theWindow);
    end;

procedure xWindow.hide;
    begin
        HideWindow(theWindow);
    end;

procedure xWindow.show;
    begin
        ShowWindow(theWindow);
    end;

procedure xWindow.move (left, top: integer);
    begin
        MoveWindow(theWindow, left, top, false);
    end;

procedure xWindow.setWindowSize (width, height: integer);
    begin
        SizeWindow(theWindow, width, height, false);
        AdjustToNewSize;
    end;

procedure xWindow.SetUserRef (theRef: longint);
    begin
        userRef := theRef;
    end;

function xWindow.GetUserRef: longint;
    begin
        GetUserRef := userRef;
    end;

procedure xWindow.AdjustToNewSize;
    var
        newHeight, newWidth: integer;
        savePort: GrafPtr;
        d: xWindowDecoration;
    begin
        newWidth := theWindow^.portRect.right - theWindow^.portRect.left;
        newHeight := theWindow^.portRect.bottom - theWindow^.portRect.top;
        if hasHScroll in features then
            HideControl(hScroll);
        if hasVScroll in features then
            HideControl(vScroll);
        SizeWindow(theWindow, newWidth, newHeight, false);
        GetPort(savePort);
        SetPort(theWindow);
        if hasHScroll in features then begin
                MoveControl(hScroll, theWindow^.portRect.left - 1 + hScrollLeftOffset, theWindow^.portRect.bottom - 15);
                if (hasVscroll in features) | (hasGrow in features) then
                    newWidth := newWidth - 13
                else
                    newWidth := newWidth + 2;
                SizeControl(hScroll, newWidth - hScrollLeftOffset - hScrollRightOffset, 16);
                ShowControl(hScroll);
            end;
        if hasVScroll in features then begin
                MoveControl(vScroll, theWindow^.portRect.right - 15, theWindow^.portRect.top - 1 + vScrollTopOffset);
                if hasGrow in features then
                    newHeight := newHeight - 13
                else
                    newHeight := newHeight + 2;
                SizeControl(vScroll, 16, newHeight - vScrollTopOffset - vScrollBottomOffset);
                ShowControl(vScroll);
            end;
        d := decorations;
        while d <> nil do begin
                d.adjustSize;
                d := d.nextDecoration;
            end;
        InvalRect(theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xWindow.doEvent (event: eventRecord);
    begin
        case event.what of
            keyDown, autoKey:
                doKey(chr(BitAnd(event.message, $FF)), event.modifiers);
            mouseDown:
                doClick(event.where, event.modifiers);
            updateEvt:
                doUpdate;
            activateEvt:
                doActivate(BitAnd(event.modifiers, activeFlag) <> 0);
            otherwise
        end;
    end;

procedure xWindow.setTitle (str: string);
    begin
        SetWTitle(theWindow, str);
    end;

function xWindow.getTitle: str255;
    var
        str: str255;
    begin
        GetWTitle(theWindow, str);
        getTitle := str;
    end;

procedure xWindow.SetHMax (theMax: integer);
    begin
        if hasHScroll in features then
            SetCtlMax(hScroll, theMax);
    end;

procedure xWindow.SetVMax (theMax: integer);
    begin
        if hasVScroll in features then
            SetCtlMax(vScroll, theMax);
    end;

procedure xWindow.SetHVal (theVal: integer);
    begin
        if hasHScroll in features then
            SetCtlValue(hScroll, theVal);
    end;

procedure xWindow.SetVVal (theVal: integer);
    begin
        if hasVScroll in features then
            SetCtlValue(vScroll, theVal);
    end;

function xWindow.GetHMax: integer;
    begin
        if hasHScroll in features then
            GetHMax := GetCtlMax(hScroll)
        else
            GetHMax := 0;
    end;

function xWindow.GetVMax: integer;
    begin
        if hasVScroll in features then
            GetVMax := GetCtlMax(vScroll)
        else
            GetVMax := 0;
    end;

function xWindow.GetHVal: integer;
    var
        val: integer;
    begin
        if hasHScroll in features then
            val := GetCtlValue(hScroll)
        else
            val := 0;
        GetHVal := val;
    end;

function xWindow.GetVVal: integer;
    var
        val: integer;
    begin
        if hasVScroll in features then
            val := GetCtlValue(vScroll)
        else
            val := 0;
        GetVVal := val;
    end;

procedure xWindow.doHScroll (dh: integer);
    var
        savePort: GrafPtr;
        R: rect;
    begin
        GetPort(savePort);
        SetPort(theWindow);
        R := theWindow^.portRect;
        if hasVScroll in features then
            R.right := R.right - 15;
        if hasHScroll in features then
            r.bottom := R.bottom - 15;
        EraseRect(R);
        doReDraw(R);
        SetPort(savePort);
    end;

procedure xWindow.doVScroll (dv: integer);
    var
        savePort: GrafPtr;
        R: rect;
    begin
        GetPort(savePort);
        SetPort(theWindow);
        R := theWindow^.portRect;
        if hasVScroll in features then
            R.right := R.right - 15;
        if hasHScroll in features then
            r.bottom := R.bottom - 15;
        EraseRect(R);
        doReDraw(R);
        SetPort(savePort);
    end;

procedure continuousScroll (ctl: ControlHandle;
                                partCode: integer);
    var
        win: xWindow;
        lines: integer;
        horizontal: boolean;
        val: integer;
        max: integer;
    begin
        val := getCtlValue(ctl);
        max := getCtlMax(ctl);
        win := xWindow(ctl^^.ContrlRfCon);
        horizontal := (hasHScroll in win.features) & (ctl = win.hScroll);
        case partCode of
            inDownButton:
                if horizontal then
                    lines := win.hpixelsperline
                else
                    lines := win.vpixelsPerLine;
            inUpButton:
                if horizontal then
                    lines := -win.hpixelsperline
                else
                    lines := -win.vpixelsPerLine;
            inPageDown:
                if horizontal then
                    lines := win.hLinesPerPage
                else
                    lines := win.vLinesPerPage;
            inPageUp:
                if horizontal then
                    lines := -win.hLinesPerPage
                else
                    lines := -win.vLinesPerPage;
            otherwise
                EXIT(ContinuousScroll);
        end;
        if val + lines < 0 then
            lines := -val
        else if val + lines > max then
            lines := max - val;
        if lines <> 0 then begin
                SetCtlValue(ctl, val + lines);
                if horizontal then
                    win.doHScroll(lines)
                else
                    win.doVScroll(lines)
            end;
    end;

procedure xWindow.doClick (globalPt: point;
                                modifiers: longint);
    var
        partNum: integer;
        savePort: grafPtr;
        part: integer;
        theControl: controlHandle;
        oldVal: integer;
    begin
        if theWindow <> FrontWindow then
            SelectWindow(theWindow)
        else begin
                partNum := FindWindow(globalPt, theWindow);
                case partnum of
                    inContent:  begin
                            GetPort(savePort);
                            SetPort(theWindow);
                            GlobalToLocal(globalPt);
                            if ((not (hasHScroll in features) | (not PtInRect(globalPt, hScroll^^.contrlRect))) & (not (hasVScroll in features) | (not PtInRect(globalPt, vScroll^^.contrlRect)))) & (globalPt.h < theWindow^.portRect.right) & (globalPt.v < theWindow^.portRect.bottom) then
                                doContentClick(globalPt, modifiers)
                            else begin
                                    part := FindControl(globalPt, theWindow, theControl);
                                    if (theControl <> hScroll) & (theControl <> vScroll) then begin
                                        end
                                    else if part in [inUpButton, inDownButton, inPageUp, inPageDown] then
                                        part := TrackControl(theControl, globalPt, @continuousScroll)
                                    else if part = inThumb then begin
                                            oldVal := GetCtlValue(theControl);
                                            part := TrackControl(theControl, globalPt, nil);
                                            if (part = inThumb) & (oldVal <> GetCtlValue(theControl)) then
                                                if theControl = HScroll then
                                                    doHScroll(GetCtlValue(theControl) - oldVal)
                                                else
                                                    doVScroll(GetCtlValue(theControl) - oldVal)
                                        end;
                                end;
                            SetPort(savePort);
                        end;
                    inDrag:
                        doDrag(globalPt);
                    inGrow:
                        DoGrow(globalPt);
                    inGoAway:
                        if TrackGoAway(theWindow, globalPt) then
                            doClose;
                    inZoomIn, inZoomOut:
                        doZoom(globalPt, partNum);
                end;
            end;
    end;

procedure xWindow.doGrow (startPt: point);
    var
        R: rect;
        newSize: longint;
        height, width: integer;
        savePort: GrafPtr;
    begin
        SetRect(R, minSize.h, minSize.v, maxSize.h, maxSize.v);
        newSize := GrowWindow(theWindow, startPt, R);
        if newSize <> 0 then begin
                width := LoWord(newSize);
                height := HiWord(newSize);
                GetPort(savePort);
                SetPort(theWindow);
                eraseRect(theWindow^.portRect);
                SizeWindow(theWindow, Width, Height, false);
                AdjustToNewSize;
                SetPort(savePort);
            end;
    end;

procedure xWindow.doDrag (startPt: point);
    var
        R: Rect;
    begin
        R := screenBits.bounds;
        R.top := 20;
        InsetRect(R, 4, 4);
        DragWindow(theWindow, startPt, R);
    end;

procedure xWindow.doZoom (startPt: point;
                                partNum: integer);
    var
        savePort: GrafPtr;
    begin
        if not TrackBox(theWindow, startPt, partNum) then
            EXIT(doZoom);
        getPort(savePort);
        setPort(theWindow);
        eraseRect(theWindow^.portRect);
        ZoomWindow(theWindow, partNum, false);
        AdjustToNewSize;
        SetPort(savePort);
    end;

procedure xWindow.doUpdate;
    var
        savePort: GrafPtr;
        R: rect;
        oldPen: penState;
    begin
        GetPort(savePort);
        SetPort(theWindow);
        BeginUpdate(theWindow);
        EraseRect(theWindow^.portRect);
        if hasGrow in features then begin
                GetPenState(oldPen);
                PenSize(1, 1);
                PenPat(black);
                DrawGrowIcon(theWindow);
                R := theWindow^.portRect;
                PenMode(notPatCopy);
                if not (hasHScroll in features) then begin
                        MoveTo(R.left, R.bottom - 15);
                        LineTo(R.right - 16, R.bottom - 15);
                    end
                else if hScrollLeftOffset > 0 then begin
                        MoveTo(R.left, R.bottom - 15);
                        LineTo(hScrollLeftOffset - 1, R.bottom - 15);
                        PenMode(PatCopy);
                        Line(0, 14);
                        PenMode(notPatCopy);
                    end;
                if not (hasVScroll in features) then begin
                        MoveTo(R.Right - 15, R.top);
                        LineTo(R.right - 15, R.bottom - 16);
                    end
                else if vScrollTopOffset > 0 then begin
                        MoveTo(R.right - 15, R.top);
                        LineTo(R.right - 15, vScrollTopOffset - 1);
                        PenMode(PatCopy);
                        Line(14, 0);
                    end;
                PenMode(PatCopy);
                SetPenState(oldPen);
            end;
        UpdtControl(theWindow, theWindow^.visRgn);
        doReDraw(theWindow^.visRgn^^.rgnBBox);
        EndUpdate(theWindow);
        SetPort(savePort);
    end;

procedure xWindow.doActivate (active: boolean);
    var
        savePort: grafPtr;
        R: rect;
        d: xWindowDecoration;
    begin
        if hasGrow in features then begin { force redraw of grow icon }
                GetPort(savePort);
                SetPort(theWindow);
                R := theWindow^.portRect;
                R.top := R.bottom - 13;
                R.left := R.right - 13;
                InvalRect(R);
                SetPort(savePort);
            end;
        if active then begin
                if hasVScroll in features then
                    ShowControl(vScroll);
                if hasHscroll in features then
                    ShowControl(hScroll);
            end
        else begin
                if hasVScroll in features then
                    HideControl(vScroll);
                if hasHscroll in features then
                    HideControl(hScroll);
            end;
        d := decorations;
        while d <> nil do begin
                d.doActivate(active);
                d := d.nextDecoration;
            end;
    end;

procedure xWindow.adjustCursor (localPt: point);
    var
        d: xWindowDecoration;
    begin
        d := decorations;
        while d <> nil do
            if PtInRect(localPt, d.clickRect) & not d.grayedOut & d.visible then begin
                    SetCursor(d.itsCursor);
                    EXIT(adjustCursor);
                end
            else
                d := d.nextDecoration;
        setCursor(arrow);
    end;

procedure xWindowDecoration.init;
    begin
        itsWindow := nil;
        nextDecoration := nil;
        visible := true;
        wantsKey := false;
        wantsClick := false;
        wantsCR := false;
        itsCursor := arrow;
        grayedOut := false;
    end;


procedure xWindowDecoration.install (Win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    var
        savePort: GrafPtr;
        d: xWindowDecoration;
    begin
        left := theLeft;
        top := theTop;
        width := theWidth;
        height := theHeight;
        itsWindow := win;
        nextDecoration := nil;
        if win.decorations = nil then
            win.decorations := self
        else begin
                d := win.decorations;
                while d.nextDecoration <> nil do
                    d := d.nextDecoration;
                d.nextDecoration := self;
            end;
        adjustSize;
        if (win.theWindow <> nil) & visible then begin
                GetPort(savePort);
                SetPort(win.theWindow);
                InvalRect(drawRect);
                SetPort(savePort);
            end;
    end;

procedure xWindowDecoration.remove;
    var
        savePort: GrafPtr;
        d: xWindowDecoration;
        found: boolean;
    begin
        if itsWindow <> nil then begin
                d := itsWindow.decorations;
                found := false;
                if d = self then begin
                        itsWindow.decorations := itsWindow.decorations.nextDecoration;
                        found := true;
                    end
                else begin
                        while (d <> nil) & (d.nextDecoration <> self) do
                            d := d.nextDecoration;
                        if d <> nil then begin
                                d.nextDecoration := d.nextDecoration.nextDecoration;
                                found := true;
                            end;
                    end;
                if found & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        InvalRect(drawRect);
                        SetPort(savePort);
                    end;
                itsWindow := nil;
                nextDecoration := nil;
            end;
    end;

procedure xWindowDecoration.move (newLeft, newTop: integer);
    var
        savePort: GrafPtr;
    begin
        if (newLeft <> left) | (newTop <> top) then begin
                left := newLeft;
                top := newTop;
                GetPort(savePort);
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        InvalRect(drawRect);
                        SetPort(savePort);
                        adjustSize;
                    end;
            end;
    end;

procedure xWindowDecoration.setSize (newWidth, newHeight: integer);
    var
        savePort: GrafPtr;
    begin
        if (newHeight <> height) | (newWidth <> width) then begin
                height := newHeight;
                width := newWidth;
                GetPort(savePort);
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        if visible then
                            InvalRect(drawRect);
                        adjustSize;
                        if visible then
                            InvalRect(drawRect);
                        SetPort(savePort);
                    end;
            end;
    end;

procedure xWindowDecoration.kill;
    begin
        remove;
        dispose(self);
    end;

procedure xWindowDecoration.hide;
    var
        savePort: GrafPtr;
    begin
        if visible then begin
                visible := false;
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        InvalRect(drawRect);
                        SetPort(savePort);
                    end;
            end;
    end;

procedure xWindowDecoration.show;
    var
        savePort: GrafPtr;
    begin
        if not visible then begin
                visible := true;
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                        GetPort(savePort);
                        SetPort(itsWindow.theWindow);
                        InvalRect(drawRect);
                        SetPort(savePort);
                    end;
            end;
    end;

procedure xWindowDecoration.useCursor (c: cursor);
    begin
        itsCursor := c;
    end;

procedure xWindowDecoration.forceRedraw;
    var
        savePort: GrafPtr;
    begin
        if (itsWindow = nil) | (itsWindow.theWindow = nil) then
            EXIT(forceRedraw);
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        InvalRect(drawRect);
        SetPort(savePort);
    end;

procedure xWindowDecoration.adjustSize;
    begin
        if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                if left < 0 then
                    drawRect.left := itsWindow.theWindow^.portRect.right + left
                else
                    drawRect.left := left;
                if top < 0 then
                    drawRect.top := itsWindow.theWindow^.portRect.bottom + top
                else
                    drawRect.top := top;
                if height <= 0 then
                    drawRect.bottom := itsWindow.theWindow^.portRect.bottom + height
                else
                    drawRect.bottom := drawRect.top + height;
                if width <= 0 then
                    drawRect.right := itsWindow.theWindow^.portRect.right + width
                else
                    drawRect.right := drawRect.left + width;
                clickRect := drawRect;
            end;
    end;

procedure xWindowDecoration.doCR (ch: char);
    begin
    end;

procedure xWindowDecoration.doKey (ch: char;
                                modifiers: longint);
    begin
    end;

procedure xWindowDecoration.doClick (localPt: point;
                                modifiers: longint);
    begin
    end;

procedure xWindowDecoration.doDraw;
    begin
    end;

procedure xWindowDecoration.doActivate (active: boolean);
    begin
    end;

procedure xWindowDecoration.Idle;
    begin
    end;

end.